home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 22 / AACD 22.iso / AACD / Programming / powerd / examples / adom.d < prev    next >
Encoding:
Text File  |  2000-09-08  |  4.3 KB  |  192 lines
  1. MODULE    'intuition/intuition','utility/tagitem','graphics/text'
  2.  
  3. ENUM    NO,UP,DO,LE,RI,UL,UR,DL,DR,LU,LD
  4.  
  5. PROC DrawMap(w:PTR TO Window,map:PTR TO CHAR,wi,he,le)
  6.     DEF    x,y,c,s:PTR TO CHAR
  7.     map:=map+le*wi*he
  8.     s:=' '
  9.     FOR y:=0 TO he-1
  10.         FOR x:=0 TO wi-1
  11.             s[0]:=map[y*wi+x]
  12.  
  13.             SELECT s[0]
  14.             CASE "#"
  15.                 c:=2
  16.             CASE ".","&","<",">"
  17.                 c:=4
  18.             CASE "+","/",34,"*"
  19.                 c:=5
  20.             CASE "~"
  21.                 c:=3
  22.             DEFAULT
  23.                 c:=6
  24.             ENDSELECT
  25.  
  26.             PrintIText(w.RPort,[c,1,1,0,0,['topaz.font',8,FS_NORMAL,FPF_ROMFONT]:TextAttr,s,NIL]:IntuiText,x*8+16,y*8+16)
  27.  
  28.         ENDFOR
  29.     ENDFOR
  30. ENDPROC
  31.  
  32. PROC Game(w:PTR TO Window,map:PTR TO CHAR,wi,he,le)
  33.     DEF    x=0,y=0,msg:PTR TO IntuiMessage,run=TRUE,tmp="@":UBYTE,go,nx=0,ny=0,
  34.             str:PTR TO CHAR
  35.     tmp:=:map[le*wi*he+y*wi+x]            // put man
  36.     DrawMap(w,map,wi,he,le)
  37.     WHILE run
  38.         WaitPort(w.UserPort)
  39.         IF msg:=GetMsg(w.UserPort)
  40.             SELECT msg.Class
  41.             CASE IDCMP_VANILLAKEY
  42.                 go:=NO
  43.                 SELECT msg.Code
  44.                 CASE "8";    go:=UP
  45.                 CASE "4";    go:=LE
  46.                 CASE "6";    go:=RI
  47.                 CASE "2";    go:=DO
  48.                 CASE "7";    go:=UL
  49.                 CASE "9";    go:=UR
  50.                 CASE "1";    go:=DL
  51.                 CASE "3";    go:=DR
  52.                 CASE "<";    go:=LU
  53.                 CASE ">";    go:=LD
  54.                 CASE "o";    OpenDoor(map,x,y,wi,he,le)
  55.                 CASE "c";    CloseDoor(map,x,y,wi,he,le)
  56.                 ENDSELECT
  57.                 IF go
  58.                     tmp:=:map[le*wi*he+y*wi+x]        // get man
  59.                     SELECT go
  60.                     CASE UP;    ny:=y-1
  61.                     CASE DO;    ny:=y+1
  62.                     CASE LE;    nx:=x-1
  63.                     CASE RI;    nx:=x+1
  64.                     CASE UL;    ny:=y-1;    nx:=x-1
  65.                     CASE UR;    ny:=y-1;    nx:=x+1
  66.                     CASE DL;    ny:=y+1;    nx:=x-1
  67.                     CASE DR;    ny:=y+1;    nx:=x+1
  68.                     CASE LU;    IF map[le*wi*he+y*wi+x]="<" THEN le--
  69.                     CASE LD;    IF map[le*wi*he+y*wi+x]=">" THEN le++
  70.                     ENDSELECT
  71.                     IF nx<0  THEN nx:=0                // bounds
  72.                     IF ny<0  THEN ny:=0
  73.                     IF nx>15 THEN nx:=15
  74.                     IF ny>15 THEN ny:=15
  75.                     SELECT map[le*wi*he+ny*wi+nx]
  76.                     CASE "#","+";    nx:=x;    ny:=y
  77.                     CASE "~";        str:='HEEELP!   '
  78.                     CASE "&";        str:='STATUE    '
  79.                     CASE 34;            str:='BOOK      '
  80.                     CASE "/";        str:='DOOR      '
  81.                     CASE "*";        str:='STONE     '
  82.                     CASE "<";        str:='UPSTAIRS  '
  83.                     CASE ">";        str:='DOWNSTAIRS'
  84.                     DEFAULT;            str:='          '
  85.                     ENDSELECT
  86.                     x:=nx
  87.                     y:=ny
  88.                     tmp:=:map[le*wi*he+y*wi+x]        // put man
  89.                 ENDIF
  90.                 DrawMap(w,map,wi,he,le)
  91.                 PrintIText(w.RPort,[2,0,1,0,0,NIL,str,NIL]:IntuiText,0,0)
  92.             CASE IDCMP_CLOSEWINDOW
  93.                 run:=FALSE
  94.             ENDSELECT
  95.             ReplyMsg(msg)
  96.         ENDIF
  97.     ENDWHILE
  98. ENDPROC
  99.  
  100. PROC OpenDoor(map:PTR TO CHAR,x,y,wi,he,le)
  101.     DEF    door=0,dx,dy,i,j
  102.     map:=map+le*wi*he
  103.     FOR j:=-1 TO 1
  104.         FOR i:=-1 TO 1
  105.             IF map[(y+j)*wi+x+i]="+"
  106.                 door++
  107.                 dx:=x+i
  108.                 dy:=y+j
  109.             ENDIF
  110.         ENDFOR
  111.     ENDFOR
  112.     IF door=1
  113.         map[dy*wi+dx]:="/"
  114.     ENDIF
  115. ENDPROC
  116.  
  117. PROC CloseDoor(map:PTR TO CHAR,x,y,wi,he,le)
  118.     DEF    door=0,dx,dy,i,j
  119.     map:=map+le*wi*he
  120.     FOR j:=-1 TO 1
  121.         FOR i:=-1 TO 1
  122.             IF map[(y+j)*wi+x+i]="/"
  123.                 door++
  124.                 dx:=x+i
  125.                 dy:=y+j
  126.             ENDIF
  127.         ENDFOR
  128.     ENDFOR
  129.     IF door=1
  130.         map[dy*wi+dx]:="+"
  131.     ENDIF
  132. ENDPROC
  133.  
  134. PROC main()
  135.     DEF    map:PTR TO CHAR,w:PTR TO Window
  136.     map:=
  137.         '................'+
  138.         '.........######.'+
  139.         '..#####..#>...#.'+
  140.         '..#...#..#....#.'+
  141.         '..#...#..##/###.'+
  142.         '..###.#.........'+
  143.         '....#.+.........'+
  144.         '....###.........'+
  145.         '................'+
  146.         '................'+
  147.         '................'+
  148.         '..".....~~......'+
  149.         '..#+#..~&~~.....'+
  150.         '..#>#..~~~~.....'+
  151.         '..###.~~~~~.....'+
  152.         '.......~~~~.....'+
  153.  
  154.         '################'+
  155.         '################'+
  156.         '#####....+<...##'+
  157.         '#.#...####....##'+
  158.         '#.#...#####/####'+
  159.         '#+###.###......#'+
  160.         '#..##.#........#'+
  161.         '#.#####........#'+
  162.         '#.+............#'+
  163.         '####...........#'+
  164.         '#..+...........#'+
  165.         '#.###...****...#'+
  166.         '#.#.#.*****....#'+
  167.         '#.#<#..*****...#'+
  168.         '#.+.#.******...#'+
  169.         '################'
  170.  
  171.     IF w:=OpenWindowTags(NIL,
  172.             WA_InnerWidth,20*8,
  173.             WA_InnerHeight,20*8,
  174.             WA_Title,'Dungeon by MarK',
  175.             WA_Flags,WFLG_ACTIVATE|WFLG_RMBTRAP|WFLG_GIMMEZEROZERO|WFLG_CLOSEGADGET|WFLG_DRAGBAR|WFLG_DEPTHGADGET,
  176.             WA_IDCMP,IDCMP_CLOSEWINDOW|IDCMP_VANILLAKEY,
  177.             TAG_END)
  178.         EasyRequestArgs(w,[SIZEOF_EasyStruct,0,'ADOM request',
  179.             'This is only small example in PowerD v0.12\n'+
  180.             'based on Great free game A.D.O.M. (see AmiNet)\n\n'+
  181.             'Control:\n'+
  182.             'use numeric keyboard for moving\n'+
  183.             '"<" go up, only possible on "<" char on the map\n'+
  184.             '">" go down, only possible on ">" char on the map\n'+
  185.             '"o" and "c" to open/close near door\n\n'+
  186.             '       Bye, MarK',
  187.             'OK']:EasyStruct,0,NIL)
  188.         Game(w,map,16,16,0)
  189.         CloseWindow(w)
  190.     ENDIF
  191. ENDPROC
  192.